home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / alloc.c next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  2.4 KB  |  129 lines  |  [TEXT/R*ch]
  1. /* 1. Allocation functions doing the same work as the macros in the
  2.       case where [Setup_for_gc] and [Restore_after_gc] are no-ops.
  3.    2. Convenience functions related to allocation.
  4. */
  5.  
  6. #include "alloc.h"
  7. #include "debugger.h"
  8. #include "major_gc.h"
  9. #include "memory.h"
  10. #include "mlvalues.h"
  11. #include "stacks.h"
  12.  
  13. #define Setup_for_gc
  14. #define Restore_after_gc
  15.  
  16. value alloc (wosize, tag)
  17.      mlsize_t wosize;
  18.      tag_t tag;
  19. {
  20.   value result;
  21.   
  22.   Assert (wosize > 0 && wosize <= Max_young_wosize);
  23.   Alloc_small (result, wosize, tag);
  24.   return result;
  25. }
  26.  
  27. value alloc_tuple(n)
  28.      mlsize_t n;
  29. {
  30.   return alloc(n, 0);
  31. }
  32.  
  33. value alloc_string (len)
  34.      mlsize_t len;
  35. {
  36.   value result;
  37.   mlsize_t offset_index;
  38.   mlsize_t wosize = (len + sizeof (value)) / sizeof (value);
  39.  
  40.   if (wosize <= Max_young_wosize) {
  41.     Alloc_small (result, wosize, String_tag);
  42.   }else{
  43.     result = alloc_shr (wosize, String_tag);
  44.   }
  45.   Field (result, wosize - 1) = 0;
  46.   offset_index = Bsize_wsize (wosize) - 1;
  47.   Byte (result, offset_index) = offset_index - len;
  48.   return result;
  49. }
  50.  
  51. value alloc_final (len, fun, mem, max)
  52.      mlsize_t len;
  53.      final_fun fun;
  54.      mlsize_t mem, max;
  55. {
  56.   value result = alloc_shr (len, Final_tag);
  57.  
  58.   Field (result, 0) = (value) fun;
  59.   adjust_gc_speed (mem, max);
  60.   return result;
  61. }
  62.  
  63. value copy_double(d)
  64.      double d;
  65. {
  66.   value res;
  67.  
  68.   Alloc_small(res, Double_wosize, Double_tag);
  69.   Store_double_val(res, d);
  70.   return res;
  71. }
  72.  
  73. value copy_string(s)
  74.      char * s;
  75. {
  76.   int len;
  77.   value res;
  78.  
  79.   len = strlen(s);
  80.   res = alloc_string(len);
  81.   bcopy(s, String_val(res), len);
  82.   return res;
  83. }
  84.  
  85. value alloc_array(funct, arr)
  86.      value (*funct) P((char *));
  87.      char ** arr;
  88. {
  89.   mlsize_t nbr, n;
  90.   value v;
  91.  
  92.   nbr = 0;
  93.   while (arr[nbr] != 0) nbr++;
  94.   if (nbr == 0) {
  95.     return Atom(0);
  96.   } else {
  97.     Push_roots(r, 1);
  98.     r[0] = nbr < Max_young_wosize ? alloc(nbr, 0) : alloc_shr(nbr, 0);
  99.     for (n = 0; n < nbr; n++)
  100.       Field(r[0], n) = Val_long(0);
  101.     for (n = 0; n < nbr; n++) {
  102.       v = funct(arr[n]);
  103.       modify(&Field(r[0], n), v);
  104.     }
  105.     v = r[0];
  106.     Pop_roots();
  107.     return v;
  108.   }
  109. }
  110.  
  111. value copy_string_array(arr)
  112.      char ** arr;
  113. {
  114.   return alloc_array(copy_string, arr);
  115. }
  116.  
  117. int convert_flag_list(list, flags)
  118.      value list;
  119.      int * flags;
  120. {
  121.   int res;
  122.   res = 0;
  123.   while (Tag_val(list) == 1) {
  124.     res |= flags[Tag_val(Field(list, 0))];
  125.     list = Field(list, 1);
  126.   }
  127.   return res;
  128. }
  129.